home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue41 / Alfresco / AAGraphs.pas next >
Encoding:
Pascal/Delphi Source File  |  1998-12-09  |  42.4 KB  |  1,326 lines
  1. {*********************************************************}
  2. {* AAGraphs                                              *}
  3. {* Copyright (c) Julian M Bucknall 1998                  *}
  4. {* All rights reserved.                                  *}
  5. {*********************************************************}
  6. {* Graph classes                                         *}
  7. {*********************************************************}
  8.  
  9. {Note: this unit is released as freeware. In other words, you are free
  10.        to use this unit in your own applications, however I retain all
  11.        copyright to the code. JMB}
  12.  
  13. unit AAGraphs;
  14.  
  15. interface
  16.  
  17. uses
  18.   SysUtils, Classes, AAPQueue;
  19.  
  20. const
  21.   EdgeNotPresent = longint(-1);
  22.  
  23. type
  24.   TaaGraph = class
  25.     private
  26.       gIsDigraph : boolean;
  27.       gNodeCount : integer;
  28.     protected
  29.       function gGetEdge(aFromIndex, aToIndex : integer) : longint; virtual; abstract;
  30.       function gGetNode(aIndex : integer) : pointer; virtual; abstract;
  31.       procedure gSetEdge(aFromIndex, aToIndex : integer;
  32.                          aValue : longint); virtual; abstract;
  33.       procedure gSetNode(aIndex : integer; aValue : pointer); virtual; abstract;
  34.     public
  35.       constructor Create(aNodeCount : integer);
  36.  
  37.       function GetNodeEdge(aFromIndex : integer;
  38.                            aNthEdge   : integer;
  39.                        var aEdge      : longint;
  40.                        var aToIndex   : integer) : boolean; virtual; abstract;
  41.  
  42.       property Edges[aFromIndex, aToIndex : integer] : longint
  43.          read gGetEdge write gSetEdge;
  44.  
  45.       property IsDigraph : boolean
  46.          read gIsDigraph;
  47.  
  48.       property NodeCount : integer
  49.          read gNodeCount;
  50.  
  51.       property Nodes[aIndex : integer] : pointer
  52.          read gGetNode write gSetNode;
  53.   end;
  54.  
  55.   TaaFullMatrixGraph = class(TaaGraph)
  56.     private
  57.       mgNodes : TList;
  58.       mgEdges : TList;
  59.     protected
  60.       function gGetEdge(aFromIndex, aToIndex : integer) : longint; override;
  61.       function gGetNode(aIndex : integer) : pointer; override;
  62.       procedure gSetEdge(aFromIndex, aToIndex : integer;
  63.                          aValue : longint); override;
  64.       procedure gSetNode(aIndex : integer; aValue : pointer); override;
  65.  
  66.     public
  67.       constructor Create(aNodeCount : integer; aIsDigraph : boolean);
  68.       destructor Destroy; override;
  69.  
  70.       function GetNodeEdge(aFromIndex : integer;
  71.                            aNthEdge   : integer;
  72.                        var aEdge      : longint;
  73.                        var aToIndex   : integer) : boolean; override;
  74.   end;
  75.  
  76.   TaaTriMatrixGraph = class(TaaGraph)
  77.     private
  78.       mgNodes : TList;
  79.       mgEdges : TList;
  80.     protected
  81.       function gGetEdge(aFromIndex, aToIndex : integer) : longint; override;
  82.       function gGetNode(aIndex : integer) : pointer; override;
  83.       procedure gSetEdge(aFromIndex, aToIndex : integer;
  84.                          aValue : longint); override;
  85.       procedure gSetNode(aIndex : integer; aValue : pointer); override;
  86.  
  87.     public
  88.       constructor Create(aNodeCount : integer);
  89.       destructor Destroy; override;
  90.  
  91.       function GetNodeEdge(aFromIndex : integer;
  92.                            aNthEdge   : integer;
  93.                        var aEdge      : longint;
  94.                        var aToIndex   : integer) : boolean; override;
  95.   end;
  96.  
  97.   TaaLinkListGraph = class(TaaGraph)
  98.     private
  99.       lgNodes : TList;
  100.     protected
  101.       function gGetEdge(aFromIndex, aToIndex : integer) : longint; override;
  102.       function gGetNode(aIndex : integer) : pointer; override;
  103.       procedure gSetEdge(aFromIndex, aToIndex : integer;
  104.                          aValue : longint); override;
  105.       procedure gSetNode(aIndex : integer; aValue : pointer); override;
  106.  
  107.       procedure lgCreateEmptyLinkedList(aAtIndex : integer);
  108.       procedure lgDestroyLinkedList(aAtIndex : integer);
  109.       procedure lgSetEdgePrim(aFromIndex, aToIndex : integer;
  110.                               aValue : longint);
  111.     public
  112.       constructor Create(aNodeCount : integer; aIsDigraph : boolean);
  113.       destructor Destroy; override;
  114.  
  115.       function GetNodeEdge(aFromIndex : integer;
  116.                            aNthEdge   : integer;
  117.                        var aEdge      : longint;
  118.                        var aToIndex   : integer) : boolean; override;
  119.   end;
  120.  
  121. type
  122.   TaaProcessNode = procedure (aSender    : TObject;
  123.                               aNodeInx   : integer;
  124.                               aExtraData : pointer);
  125.   TaaEvalPriority = function (aSender    : TObject;
  126.                               aFromIndex : integer;
  127.                               aEdgeCost  : longint;
  128.                               aToIndex   : integer) : longint;
  129.  
  130.   TaaDepthFirstIterator = class
  131.     private
  132.       dfiGraph       : TaaGraph;
  133.       dfiNodes       : TList;
  134.       dfiPostProcess : TaaProcessNode;
  135.       dfiPreProcess  : TaaProcessNode;
  136.       dfiProcessSortedNode : TaaProcessNode;
  137.     protected
  138.       procedure dfiDestroyCounter(aIndex : integer);
  139.       procedure dfiExecutePrim(aFromIndex : integer;
  140.                            var aHasCycle  : boolean;
  141.                                aExtraData : pointer);
  142.     public
  143.       constructor Create(aGraph : TaaGraph);
  144.       destructor Destroy; override;
  145.  
  146.       procedure Execute(aFromIndex : integer;
  147.                     var aHasCycle  : boolean;
  148.                         aExtraData : pointer);
  149.       procedure ExecuteAll(var aHasCycle  : boolean;
  150.                                aExtraData : pointer);
  151.       procedure Reset;
  152.       procedure TopologicalSort(aExtraData : pointer);
  153.  
  154.       property OnPreProcess : TaaProcessNode
  155.          read dfiPreProcess write dfiPreProcess;
  156.       property OnPostProcess : TaaProcessNode
  157.          read dfiPostProcess write dfiPostProcess;
  158.       property OnProcessSortedNode : TaaProcessNode
  159.          read dfiProcessSortedNode write dfiProcessSortedNode;
  160.   end;
  161.  
  162.   TaaBreadthFirstIterator = class
  163.     private
  164.       bfiGraph       : TaaGraph;
  165.       bfiNodes       : TList;
  166.       bfiPostProcess : TaaProcessNode;
  167.       bfiPreProcess  : TaaProcessNode;
  168.       bfiPrintNode   : TaaProcessNode;
  169.       bfiQueue       : pointer;
  170.       bfiQueueTail   : pointer;
  171.     protected
  172.       procedure bfiDestroyCounter(aIndex : integer);
  173.  
  174.       // internal queue
  175.       procedure bfiClearQueue;
  176.       function bfiDequeue : integer;
  177.       procedure bfiEnqueue(aIndex : integer);
  178.       function bfiQueueIsEmpty : boolean;
  179.  
  180.       function bfiShortPathPrim(aFromIndex : integer;
  181.                                 aToIndex   : integer;
  182.                                 aExtraData : pointer) : boolean;
  183.     public
  184.       constructor Create(aGraph : TaaGraph);
  185.       destructor Destroy; override;
  186.  
  187.       procedure Execute(aFromIndex : integer; aExtraData : pointer);
  188.       procedure ExecuteAll(aExtraData : pointer);
  189.       procedure Reset;
  190.       function ShortestPath(aFromIndex : integer;
  191.                             aToIndex   : integer;
  192.                             aExtraData : pointer) : boolean;
  193.  
  194.       property OnPreProcess : TaaProcessNode
  195.          read bfiPreProcess write bfiPreProcess;
  196.       property OnPostProcess : TaaProcessNode
  197.          read bfiPostProcess write bfiPostProcess;
  198.       property OnPrintNode : TaaProcessNode
  199.          read bfiPrintNode write bfiPrintNode;
  200.   end;
  201.  
  202.   TaaPriorityFirstIterator = class
  203.     private
  204.       pfiGraph       : TaaGraph;
  205.       pfiNodes       : TList;
  206.       pfiPostProcess : TaaProcessNode;
  207.       pfiPreProcess  : TaaProcessNode;
  208.       pfiPrintNode   : TaaProcessNode;
  209.       pfiQueue       : TaaPriorityQueueEx;
  210.     protected
  211.       procedure pfiDestroyCounter(aIndex : integer);
  212.  
  213.       function pfiTracePathPrim(aFromIndex : integer;
  214.                                 aToIndex   : integer;
  215.                                 aExtraData : pointer) : boolean;
  216.     public
  217.       constructor Create(aGraph : TaaGraph);
  218.       destructor Destroy; override;
  219.  
  220.       function GetPriority(aNodeIndex : integer) : longint;
  221.       procedure Execute(aEvalPriority : TaaEvalPriority;
  222.                         aFromIndex    : integer;
  223.                         aExtraData    : pointer);
  224.       procedure ExecuteAll(aEvalPriority : TaaEvalPriority;
  225.                            aExtraData    : pointer);
  226.       procedure Reset;
  227.       function TracePath(aFromIndex : integer;
  228.                          aToIndex   : integer;
  229.                          aExtraData : pointer) : boolean;
  230.  
  231.       property OnPreProcess : TaaProcessNode
  232.          read pfiPreProcess write pfiPreProcess;
  233.       property OnPostProcess : TaaProcessNode
  234.          read pfiPostProcess write pfiPostProcess;
  235.       property OnPrintNode : TaaProcessNode
  236.          read pfiPrintNode write pfiPrintNode;
  237.   end;
  238.  
  239. function EvalPrimsPriority(aSender    : TObject;
  240.                            aFromIndex : integer;
  241.                            aEdgeCost  : longint;
  242.                            aToIndex   : integer) : longint;
  243.  
  244. function EvalDijkstrasPriority(aSender    : TObject;
  245.                                aFromIndex : integer;
  246.                                aEdgeCost  : longint;
  247.                                aToIndex   : integer) : longint;
  248.  
  249. procedure MinSpanningTree(aGraph       : TaaGraph;
  250.                           aProcessNode : TaaProcessNode;
  251.                           aExtraData   : pointer);
  252.  
  253. procedure SmallestCostPath(aGraph       : TaaGraph;
  254.                            aFromIndex   : integer;
  255.                            aToIndex     : integer;
  256.                            aProcessNode : TaaProcessNode;
  257.                            aExtraData   : pointer);
  258.  
  259. implementation
  260.  
  261. const
  262.   InfinitePriority = MaxLongint;
  263.  
  264.  
  265. {===TaaGraph=========================================================}
  266. constructor TaaGraph.Create(aNodeCount : integer);
  267. begin
  268.   inherited Create;
  269.   gNodeCount := aNodeCount;
  270. end;
  271. {====================================================================}
  272.  
  273.  
  274. {===TaaFullMatrixGraph===============================================}
  275. constructor TaaFullMatrixGraph.Create(aNodeCount : integer; aIsDigraph : boolean);
  276. var
  277.   i : integer;
  278. begin
  279.   inherited Create(aNodeCount);
  280.   mgNodes := TList.Create;
  281.   mgNodes.Count := aNodeCount;
  282.   mgEdges := TList.Create;
  283.   mgEdges.Count := aNodeCount * aNodeCount;
  284.   for i := 0 to pred(mgEdges.Count) do
  285.     mgEdges[i] := pointer(EdgeNotPresent);
  286.   gIsDigraph := aIsDigraph;
  287. end;
  288. {--------}
  289. destructor TaaFullMatrixGraph.Destroy;
  290. begin
  291.   mgEdges.Free;
  292.   mgNodes.Free;
  293.   inherited Destroy;
  294. end;
  295. {--------}
  296. function TaaFullMatrixGraph.GetNodeEdge(aFromIndex : integer;
  297.                                         aNthEdge   : integer;
  298.                                     var aEdge      : longint;
  299.                                     var aToIndex   : integer) : boolean;
  300. var
  301.   i          : integer;
  302.   BeginIndex : integer;
  303. begin
  304.   Result := false;
  305.   if (aFromIndex < 0) or
  306.      (aFromIndex >= mgNodes.Count) or
  307.      (aNthEdge < 0) then
  308.     Exit;
  309.   BeginIndex := aFromIndex * NodeCount;
  310.   for i := BeginIndex to pred(BeginIndex + NodeCount) do begin
  311.     if (mgEdges[i] <> nil) then begin
  312.       if (aNthEdge = 0) then begin
  313.         Result := true;
  314.         aEdge := longint(mgEdges[i]);
  315.         aToIndex := i - BeginIndex;
  316.         Exit;
  317.       end;
  318.       dec(aNthEdge);
  319.     end;
  320.   end;
  321. end;
  322. {--------}
  323. function TaaFullMatrixGraph.gGetEdge(aFromIndex, aToIndex : integer) : longint;
  324. begin
  325.   if (aFromIndex < 0) or (aFromIndex >= mgNodes.Count) then
  326.     raise Exception.Create('TaaTriMatrixGraph.gGetEdge: from node index out of range');
  327.   if (aToIndex < 0) or (aToIndex >= mgNodes.Count) then
  328.     raise Exception.Create('TaaTriMatrixGraph.gGetEdge: to node index out of range');
  329.   Result := longint(mgEdges[(aFromIndex * NodeCount) + aToIndex]);
  330. end;
  331. {--------}
  332. function TaaFullMatrixGraph.gGetNode(aIndex : integer) : pointer;
  333. begin
  334.   if (aIndex < 0) or (aIndex >= mgNodes.Count) then
  335.     raise Exception.Create('TaaTriMatrixGraph.gGetNode: node index out of range');
  336.   Result := mgNodes[aIndex];
  337. end;
  338. {--------}
  339. procedure TaaFullMatrixGraph.gSetEdge(aFromIndex, aToIndex : integer;
  340.                                       aValue : longint);
  341. begin
  342.   if (aFromIndex < 0) or (aFromIndex >= mgNodes.Count) then
  343.     raise Exception.Create('TaaTriMatrixGraph.gSetEdge: from node index out of range');
  344.   if (aToIndex < 0) or (aToIndex >= mgNodes.Count) then
  345.     raise Exception.Create('TaaTriMatrixGraph.gSetEdge: to node index out of range');
  346.   mgEdges[(aFromIndex * NodeCount) + aToIndex] := pointer(aValue);
  347.   if (not IsDigraph) and (aFromIndex <> aToIndex) then
  348.     mgEdges[(aToIndex * NodeCount) + aFromIndex] := pointer(aValue);
  349. end;
  350. {--------}
  351. procedure TaaFullMatrixGraph.gSetNode(aIndex : integer; aValue : pointer);
  352. begin
  353.   if (aIndex < 0) or (aIndex >= mgNodes.Count) then
  354.     raise Exception.Create('TaaTriMatrixGraph.gSetNode: node index out of range');
  355.   mgNodes[aIndex] := aValue;
  356. end;
  357. {====================================================================}
  358.  
  359.  
  360. {===TaaTriMatrixGraph================================================}
  361. constructor TaaTriMatrixGraph.Create(aNodeCount : integer);
  362. var
  363.   i : integer;
  364. begin
  365.   inherited Create(aNodeCount);
  366.   mgNodes := TList.Create;
  367.   mgNodes.Count := aNodeCount;
  368.   mgEdges := TList.Create;
  369.   mgEdges.Count := (aNodeCount * succ(aNodeCount)) div 2;
  370.   for i := 0 to pred(mgEdges.Count) do
  371.     mgEdges[i] := pointer(EdgeNotPresent);
  372. end;
  373. {--------}
  374. destructor TaaTriMatrixGraph.Destroy;
  375. begin
  376.   mgEdges.Free;
  377.   mgNodes.Free;
  378.   inherited Destroy;
  379. end;
  380. {--------}
  381. function TaaTriMatrixGraph.GetNodeEdge(aFromIndex : integer;
  382.                                        aNthEdge   : integer;
  383.                                    var aEdge      : longint;
  384.                                    var aToIndex   : integer) : boolean;
  385. var
  386.   ArrayInx : integer;
  387.   ToIndex  : integer;
  388. begin
  389.   Result := false;
  390.   if (aFromIndex < 0) or
  391.      (aFromIndex >= mgNodes.Count) or
  392.      (aNthEdge < 0) then
  393.     Exit;
  394.   ArrayInx := (aFromIndex * succ(aFromIndex)) div 2;
  395.   ToIndex := 0;
  396.   {first go along horizontally along a row}
  397.   while (ToIndex <= aFromIndex) do begin
  398.     if (mgEdges[ArrayInx] <> nil) then begin
  399.       if (aNthEdge = 0) then begin
  400.         Result := true;
  401.         aEdge := longint(mgEdges[ArrayInx]);
  402.         aToIndex := ToIndex;
  403.         Exit;
  404.       end;
  405.       dec(aNthEdge);
  406.     end;
  407.     inc(ToIndex);
  408.     inc(ArrayInx);
  409.   end;
  410.   {then go vertically down a column}
  411.   inc(ArrayInx, pred(ToIndex));
  412.   while (ToIndex < NodeCount) do begin
  413.     if (mgEdges[ArrayInx] <> nil) then begin
  414.       if (aNthEdge = 0) then begin
  415.         Result := true;
  416.         aEdge := longint(mgEdges[ArrayInx]);
  417.         aToIndex := ToIndex;
  418.         Exit;
  419.       end;
  420.       dec(aNthEdge);
  421.     end;
  422.     inc(ToIndex);
  423.     inc(ArrayInx, ToIndex);
  424.   end;
  425. end;
  426. {--------}
  427. function TaaTriMatrixGraph.gGetEdge(aFromIndex, aToIndex : integer) : longint;
  428. var
  429.   Temp : integer;
  430. begin
  431.   if (aFromIndex < 0) or (aFromIndex >= mgNodes.Count) then
  432.     raise Exception.Create('TaaTriMatrixGraph.gGetEdge: from node index out of range');
  433.   if (aToIndex < 0) or (aToIndex >= mgNodes.Count) then
  434.     raise Exception.Create('TaaTriMatrixGraph.gGetEdge: to node index out of range');
  435.   if (aFromIndex < aToIndex) then begin
  436.     Temp := aFromIndex;
  437.     aFromIndex := aToIndex;
  438.     aToIndex := Temp;
  439.   end;
  440.   Result := longint(mgEdges[(aFromIndex * succ(aFromIndex)) div 2 + aToIndex]);
  441. end;
  442. {--------}
  443. function TaaTriMatrixGraph.gGetNode(aIndex : integer) : pointer;
  444. begin
  445.   if (aIndex < 0) or (aIndex >= mgNodes.Count) then
  446.     raise Exception.Create('TaaTriMatrixGraph.gGetNode: node index out of range');
  447.   Result := mgNodes[aIndex];
  448. end;
  449. {--------}
  450. procedure TaaTriMatrixGraph.gSetEdge(aFromIndex, aToIndex : integer;
  451.                                      aValue : longint);
  452. var
  453.   Temp : integer;
  454. begin
  455.   if (aFromIndex < 0) or (aFromIndex >= mgNodes.Count) then
  456.     raise Exception.Create('TaaTriMatrixGraph.gSetEdge: from node index out of range');
  457.   if (aToIndex < 0) or (aToIndex >= mgNodes.Count) then
  458.     raise Exception.Create('TaaTriMatrixGraph.gSetEdge: to node index out of range');
  459.   if (aFromIndex < aToIndex) then begin
  460.     Temp := aFromIndex;
  461.     aFromIndex := aToIndex;
  462.     aToIndex := Temp;
  463.   end;
  464.   mgEdges[(aFromIndex * succ(aFromIndex)) div 2 + aToIndex] := pointer(aValue);
  465. end;
  466. {--------}
  467. procedure TaaTriMatrixGraph.gSetNode(aIndex : integer; aValue : pointer);
  468. begin
  469.   if (aIndex < 0) or (aIndex >= mgNodes.Count) then
  470.     raise Exception.Create('TaaTriMatrixGraph.gSetNode: node index out of range');
  471.   mgNodes[aIndex] := aValue;
  472. end;
  473. {====================================================================}
  474.  
  475.  
  476. {====================================================================}
  477. type
  478.   PllNode = ^TllNode;
  479.   TllNode = packed record
  480.     llnNext    : PllNode; // next node
  481.     llnNodeInx : integer; // node index
  482.     case boolean {read as: is this the first node?} of
  483.       false : (llnEdge : longint);  // edge value or cost
  484.       true  : (llnNode : pointer); // node value
  485.   end;
  486. {-------}
  487. constructor TaaLinkListGraph.Create(aNodeCount : integer; aIsDigraph : boolean);
  488. var
  489.   i : integer;
  490. begin
  491.   inherited Create(aNodeCount);
  492.   lgNodes := TList.Create;
  493.   lgNodes.Count := aNodeCount;
  494.   for i := 0 to pred(aNodeCount) do
  495.     lgCreateEmptyLinkedList(i);
  496.   gIsDigraph := aIsDigraph;
  497. end;
  498. {--------}
  499. destructor TaaLinkListGraph.Destroy;
  500. var
  501.   i : integer;
  502. begin
  503.   for i := 0 to pred(NodeCount) do
  504.     lgDestroyLinkedList(i);
  505.   lgNodes.Free;
  506.   inherited Destroy;
  507. end;
  508. {--------}
  509. function TaaLinkListGraph.GetNodeEdge(aFromIndex : integer;
  510.                                       aNthEdge   : integer;
  511.                                   var aEdge      : longint;
  512.                                   var aToIndex   : integer) : boolean;
  513. var
  514.   WalkNode : PllNode;
  515. begin
  516.   Result := false;
  517.   if (aFromIndex < 0) or
  518.      (aFromIndex >= lgNodes.Count) or
  519.      (aNthEdge < 0) then
  520.     Exit;
  521.   WalkNode := lgNodes[aFromIndex];
  522.   while (WalkNode <> nil) and (aNthEdge >= 0) do begin
  523.     WalkNode := WalkNode^.llnNext;
  524.     dec(aNthEdge);
  525.   end;
  526.   if (WalkNode = nil) or (WalkNode^.llnNext = nil) then
  527.     Exit;
  528.   Result := true;
  529.   aEdge := WalkNode^.llnEdge;
  530.   aToIndex := WalkNode^.llnNodeInx;
  531. end;
  532. {--------}
  533. function TaaLinkListGraph.gGetEdge(aFromIndex, aToIndex : integer) : longint;
  534. var
  535.   WalkNode : PllNode;
  536. begin
  537.   if (aFromIndex < 0) or (aFromIndex >= lgNodes.Count) then
  538.     raise Exception.Create('TaaLinkListGraph.gSetEdge: from node index out of range');
  539.   if (aToIndex < 0) or (aToIndex >= lgNodes.Count) then
  540.     raise Exception.Create('TaaLinkListGraph.gSetEdge: to node index out of range');
  541.   Result := EdgeNotPresent;
  542.   WalkNode := lgNodes[aFromIndex];
  543.   while (WalkNode^.llnNodeInx < aToIndex) do
  544.     WalkNode := WalkNode^.llnNext;
  545.   if (WalkNode^.llnNodeInx = aToIndex) then
  546.     Result := WalkNode^.llnEdge;
  547. end;
  548. {--------}
  549. function TaaLinkListGraph.gGetNode(aIndex : integer) : pointer;
  550. begin
  551.   if (aIndex < 0) or (aIndex >= lgNodes.Count) then
  552.     raise Exception.Create('TaaLinkListGraph.gGetNode: node index out of range');
  553.   Result := PllNode(lgNodes[aIndex])^.llnNode;
  554. end;
  555. {--------}
  556. procedure TaaLinkListGraph.gSetEdge(aFromIndex, aToIndex : integer;
  557.                                     aValue : longint);
  558. begin
  559.   if (aFromIndex < 0) or (aFromIndex >= lgNodes.Count) then
  560.     raise Exception.Create('TaaLinkListGraph.gSetEdge: from node index out of range');
  561.   if (aToIndex < 0) or (aToIndex >= lgNodes.Count) then
  562.     raise Exception.Create('TaaLinkListGraph.gSetEdge: to node index out of range');
  563.   lgSetEdgePrim(aFromIndex, aToIndex, aValue);
  564.   if (not IsDigraph) and (aFromIndex <> aToIndex) then
  565.     lgSetEdgePrim(aToIndex, aFromIndex, aValue);
  566. end;
  567. {--------}
  568. procedure TaaLinkListGraph.gSetNode(aIndex : integer; aValue : pointer);
  569. begin
  570.   if (aIndex < 0) or (aIndex >= lgNodes.Count) then
  571.     raise Exception.Create('TaaLinkListGraph.gSetNode: node index out of range');
  572.   PllNode(lgNodes[aIndex])^.llnNode := aValue;
  573. end;
  574. {--------}
  575. procedure TaaLinkListGraph.lgCreateEmptyLinkedList(aAtIndex : integer);
  576. var
  577.   FirstNode : PllNode;
  578.   LastNode : PllNode;
  579. begin
  580.   New(LastNode);
  581.   with LastNode^ do begin
  582.     llnNext := nil;
  583.     llnEdge := 0;
  584.     llnNodeInx := $7FFFFFFF; // greater than any node index
  585.   end;
  586.   New(FirstNode);
  587.   with FirstNode^ do begin
  588.     llnNext := LastNode;
  589.     llnNode := nil;
  590.     llnNodeInx := -1; // less than any node index
  591.   end;
  592.   lgNodes[aAtIndex] := FirstNode;
  593. end;
  594. {--------}
  595. procedure TaaLinkListGraph.lgDestroyLinkedList(aAtIndex : integer);
  596. var
  597.   Dad, Son : PllNode;
  598. begin
  599.   Son := lgNodes[aAtIndex];
  600.   while (Son <> nil) do begin
  601.     Dad := Son;
  602.     Son := Dad^.llnNext;
  603.     Dispose(Dad);
  604.   end;
  605. end;
  606. {--------}
  607. procedure TaaLinkListGraph.lgSetEdgePrim(aFromIndex, aToIndex : integer;
  608.                                          aValue : longint);
  609. var
  610.   DadNode, WalkNode, NewNode : PllNode;
  611. begin
  612.   DadNode := nil;
  613.   WalkNode := lgNodes[aFromIndex];
  614.   while (WalkNode^.llnNodeInx < aToIndex) do begin
  615.     DadNode := WalkNode;
  616.     WalkNode := DadNode^.llnNext;
  617.   end;
  618.   if (WalkNode^.llnNodeInx = aToIndex) then
  619.     WalkNode^.llnEdge := aValue
  620.   else begin
  621.     New(NewNode);
  622.     with NewNode^ do begin
  623.       llnNext := WalkNode;
  624.       llnEdge := aValue;
  625.       llnNodeInx := aToIndex;
  626.     end;
  627.     DadNode^.llnNext := NewNode;
  628.   end;
  629. end;
  630. {====================================================================}
  631.  
  632.  
  633. type
  634.   PitrCounter = ^TitrCounter;
  635.   TitrCounter = packed record {Counter record for iterators}
  636.     cIndex    : integer;      {..index of this item in list}
  637.     cMarker   : integer;      {..0-unseen; 1-preproc'd; 2-postproc'd}
  638.     cParent   : integer;      {..index of predecessor node}
  639.     cLevel    : integer;      {..distance from source node}
  640.     cPriority : longint;      {..priority of node}
  641.     cHandle   : TaaPQHandle;  {..handle of node in priority queue}
  642.   end;
  643.  
  644. type
  645.   PbfiListItem = ^TbfiListItem;
  646.   TbfiListItem = record       {Linked list item for topo sort}
  647.     liIndex : integer;        {..node index}
  648.     liNext  : PbfiListItem;   {..next linked list item}
  649.   end;
  650.  
  651. type
  652.   PbfiQueueItem = ^TbfiQueueItem;
  653.   TbfiQueueItem = record      {Queue item for breadth-1st traversal}
  654.     qiIndex : integer;        {..node index}
  655.     qiNext  : PbfiQueueItem;  {..next queue item}
  656.   end;
  657.  
  658.  
  659.  
  660. {===Helper routines for iterators====================================}
  661. procedure TsAddToList(aSender    : TObject;
  662.                       aNodeInx   : integer;
  663.                       aExtraData : pointer);
  664. var
  665.   LinkedList : PbfiListItem absolute aExtraData;
  666.   Item       : PbfiListItem;
  667. begin
  668.   New(Item);
  669.   Item^.liIndex := aNodeInx;
  670.   Item^.liNext := LinkedList^.liNext;
  671.   LinkedList^.liNext := Item;
  672. end;
  673. {--------}
  674. function ComparePriority(const aItem1, aItem2 : pointer) : integer;
  675. begin
  676.   // do the reverse of the usual comparison. ie compare aItem2
  677.   // against aItem1: this will produce a min-heap priority queue
  678.   Result := PitrCounter(aItem2).cPriority -
  679.             PitrCounter(aItem1).cPriority;
  680. end;
  681. {====================================================================}
  682.  
  683.  
  684. {===TaaDepthFirstIterator============================================}
  685. constructor TaaDepthFirstIterator.Create(aGraph : TaaGraph);
  686. var
  687.   i : integer;
  688. begin
  689.   inherited Create;
  690.   if (aGraph = nil) then
  691.     raise Exception.Create('TaaDepthFirstIterator.Create: graph object is nil');
  692.   dfiGraph := aGraph;
  693.   dfiNodes := TList.Create;
  694.   dfiNodes.Count := aGraph.NodeCount;
  695.   for i := 0 to pred(dfiNodes.Count) do
  696.     dfiNodes[i] := AllocMem(sizeof(TitrCounter));
  697.   Reset;
  698. end;
  699. {--------}
  700. destructor TaaDepthFirstIterator.Destroy;
  701. var
  702.   i : integer;
  703. begin
  704.   for i := 0 to pred(dfiNodes.Count) do
  705.     dfiDestroyCounter(i);
  706.   dfiNodes.Free;
  707.   inherited Destroy;
  708. end;
  709. {--------}
  710. procedure TaaDepthFirstIterator.dfiDestroyCounter(aIndex : integer);
  711. var
  712.   Counter : PitrCounter;
  713. begin
  714.   Counter := dfiNodes[aIndex];
  715.   if (Counter <> nil) then
  716.     Dispose(Counter);
  717. end;
  718. {--------}
  719. procedure TaaDepthFirstIterator.dfiExecutePrim(aFromIndex : integer;
  720.                                            var aHasCycle  : boolean;
  721.                                                aExtraData : pointer);
  722. var
  723.   i          : integer;
  724.   NewNodeInx : integer;
  725.   Edge       : longint;
  726.   OurLevel   : integer;
  727. begin
  728.   // perform preprocessing on the node
  729.   if Assigned(dfiPreProcess) then
  730.     dfiPreProcess(Self, aFromIndex, aExtraData);
  731.   // mark the node as preprocessed
  732.   with PitrCounter(dfiNodes[aFromIndex])^ do begin
  733.     cMarker := 1;
  734.     OurLevel := cLevel;
  735.   end;
  736.   // iterate through the edges from this node
  737.   i := 0;
  738.   while dfiGraph.GetNodeEdge(aFromIndex, i, Edge, NewNodeInx) do begin
  739.     with PitrCounter(dfiNodes[NewNodeInx])^ do begin
  740.       if (cMarker = 0) then begin
  741.         cParent := aFromIndex;
  742.         cLevel := succ(OurLevel);
  743.         dfiExecutePrim(NewNodeInx, aHasCycle, aExtraData);
  744.       end
  745.       else if (cMarker = 1) then begin
  746.         // a cycle has been found!
  747.         aHasCycle := true;
  748.       end;
  749.     end;
  750.     inc(i);
  751.   end;
  752.   // perform postprocessing on the node
  753.   if Assigned(dfiPostProcess) then
  754.     dfiPostProcess(Self, aFromIndex, aExtraData);
  755.   // mark the node as postprocessed
  756.   with PitrCounter(dfiNodes[aFromIndex])^ do begin
  757.     cMarker := 2;
  758.   end;
  759. end;
  760. {--------}
  761. procedure TaaDepthFirstIterator.Execute(aFromIndex : integer;
  762.                                     var aHasCycle  : boolean;
  763.                                         aExtraData : pointer);
  764. begin
  765.   aHasCycle := false;
  766.   dfiExecutePrim(aFromIndex, aHasCycle, aExtraData);
  767. end;
  768. {--------}
  769. procedure TaaDepthFirstIterator.ExecuteAll(var aHasCycle  : boolean;
  770.                                                aExtraData : pointer);
  771. var
  772.   i : integer;
  773.   ithHasCycle : boolean;
  774. begin
  775.   aHasCycle := false;
  776.   for i := 0 to pred(dfiGraph.NodeCount) do begin
  777.     if (PitrCounter(dfiNodes[i])^.cMarker = 0) then begin
  778.       Execute(i, ithHasCycle, aExtraData);
  779.       aHasCycle := aHasCycle or ithHasCycle;
  780.     end;
  781.   end;
  782. end;
  783. {--------}
  784. procedure TaaDepthFirstIterator.Reset;
  785. var
  786.   i : integer;
  787. begin
  788.   for i := 0 to pred(dfiNodes.Count) do begin
  789.     with PitrCounter(dfiNodes[i])^ do begin
  790.       cIndex := i;
  791.       cMarker := 0;
  792.       cParent := -1;
  793.       cLevel := 0;
  794.     end;
  795.   end;
  796. end;
  797. {--------}
  798. procedure TaaDepthFirstIterator.TopologicalSort(aExtraData : pointer);
  799. var
  800.   SavedPreProc  : TaaProcessNode;
  801.   SavedPostProc : TaaProcessNode;
  802.   TSList        : PbfiListItem;
  803.   Head, Temp    : PbfiListItem;
  804.   HasCycle      : boolean;
  805. begin
  806.   if not dfiGraph.IsDigraph then
  807.     raise Exception.Create('TaaDepthFirstIterator.TopologicalSort: you can only sort a digraph');
  808.   SavedPreProc  := OnPreProcess;
  809.   SavedPostProc := OnPostProcess;
  810.   OnPreProcess := nil;
  811.   OnPostProcess := TSAddToList;
  812.   try
  813.     // create the linked list
  814.     New(TSList);
  815.     TSList^.liNext := nil;
  816.     try
  817.       // now execute the depth first traversal on all the nodes: this
  818.       // will add all the nodes to our linked list
  819.       Reset;
  820.       ExecuteAll(HasCycle, TSList);
  821.       // now trigger the event handler, cleaning up the linked list as
  822.       // we go
  823.       Head := TSList^.liNext;
  824.       try
  825.         // if there was a cycle, the topo sort is meaningless
  826.         if HasCycle then
  827.           raise Exception.Create('TaaDepthFirstIterator.TopologicalSort: digraph is not acyclic');
  828.         // walk the linked list
  829.         while (Head <> nil) do begin
  830.           // process the head node
  831.           if Assigned(dfiProcessSortedNode) then
  832.             dfiProcessSortedNode(Self, Head^.liIndex, aExtraData);
  833.           // move down the list, dispose of the old head node
  834.           Temp := Head;
  835.           Head := Head^.liNext;
  836.           Dispose(Temp);
  837.         end;
  838.       except
  839.         // on error clean up the remainder of the linked list
  840.         while (Head <> nil) do begin
  841.           Temp := Head;
  842.           Head := Head^.liNext;
  843.           Dispose(Temp);
  844.         end;
  845.         raise;
  846.       end;
  847.     finally
  848.       Dispose(TSList);
  849.     end;
  850.   finally
  851.     OnPreProcess := SavedPreProc;
  852.     OnPostProcess := SavedPostProc;
  853.   end;
  854. end;
  855. {====================================================================}
  856.  
  857.  
  858. {===TaaBreadthFirstIterator============================================}
  859. constructor TaaBreadthFirstIterator.Create(aGraph : TaaGraph);
  860. var
  861.   i : integer;
  862. begin
  863.   inherited Create;
  864.   if (aGraph = nil) then
  865.     raise Exception.Create('TaaBreadthFirstIterator.Create: graph object is nil');
  866.   bfiGraph := aGraph;
  867.   bfiNodes := TList.Create;
  868.   bfiNodes.Count := aGraph.NodeCount;
  869.   for i := 0 to pred(bfiNodes.Count) do
  870.     bfiNodes[i] := AllocMem(sizeof(TitrCounter));
  871.   Reset;
  872. end;
  873. {--------}
  874. destructor TaaBreadthFirstIterator.Destroy;
  875. var
  876.   i : integer;
  877. begin
  878.   for i := 0 to pred(bfiNodes.Count) do
  879.     bfiDestroyCounter(i);
  880.   bfiNodes.Free;
  881.   inherited Destroy;
  882. end;
  883. {--------}
  884. procedure TaaBreadthFirstIterator.bfiClearQueue;
  885. var
  886.   Head, Temp : PbfiQueueItem;
  887. begin
  888.   Head := PbfiQueueItem(bfiQueue);
  889.   while (Head <> nil) do begin
  890.     Temp := Head;
  891.     Head := Head^.qiNext;
  892.     Dispose(Temp);
  893.   end;
  894. end;
  895. {--------}
  896. function TaaBreadthFirstIterator.bfiDequeue : integer;
  897. var
  898.   Head : PbfiQueueItem;
  899. begin
  900.   Head := PbfiQueueItem(bfiQueue);
  901.   if (Head = nil) then
  902.     Result := -1
  903.   else begin
  904.     bfiQueue := pointer(Head^.qiNext);
  905.     Result := Head^.qiIndex;
  906.     Dispose(Head);
  907.     if (bfiQueue = nil) then
  908.       bfiQueueTail := nil;
  909.   end;
  910. end;
  911. {--------}
  912. procedure TaaBreadthFirstIterator.bfiDestroyCounter(aIndex : integer);
  913. var
  914.   Counter : PitrCounter;
  915. begin
  916.   Counter := bfiNodes[aIndex];
  917.   if (Counter <> nil) then
  918.     Dispose(Counter);
  919. end;
  920. {--------}
  921. procedure TaaBreadthFirstIterator.bfiEnqueue(aIndex : integer);
  922. var
  923.   Temp : PbfiQueueItem;
  924. begin
  925.   New(Temp);
  926.   Temp^.qiIndex := aIndex;
  927.   Temp^.qiNext := nil;
  928.   if (bfiQueue = nil) then
  929.     bfiQueue := pointer(Temp)
  930.   else
  931.     PbfiQueueItem(bfiQueueTail)^.qiNext := Temp;
  932.   bfiQueueTail := pointer(Temp);
  933. end;
  934. {--------}
  935. function TaaBreadthFirstIterator.bfiQueueIsEmpty : boolean;
  936. begin
  937.   Result := bfiQueue = nil;
  938. end;
  939. {--------}
  940. function TaaBreadthFirstIterator.bfiShortPathPrim(aFromIndex : integer;
  941.                                                   aToIndex   : integer;
  942.                                                   aExtraData : pointer) : boolean;
  943. var
  944.   Parent : integer;
  945. begin
  946.   if (aFromIndex = aToIndex) then begin
  947.     {we reached the source node, so print it & return success}
  948.     if Assigned(bfiPrintNode) then
  949.       bfiPrintNode(Self, aToIndex, aExtraData);
  950.     Result := true;
  951.   end
  952.   else begin
  953.     Parent := PitrCounter(bfiNodes[aToIndex])^.cParent;
  954.     if (Parent = -1) then begin
  955.       {we've hit a dead end-there is no path back to the source node}
  956.       Result := false;
  957.     end
  958.     else begin
  959.       {recurse to the parent, if successful print this node}
  960.       if bfiShortPathPrim(aFromIndex, Parent, aExtraData) then begin
  961.         if Assigned(bfiPrintNode) then
  962.           bfiPrintNode(Self, aToIndex, aExtraData);
  963.         Result := true;
  964.       end
  965.       else
  966.         Result := false;
  967.     end;
  968.   end;
  969. end;
  970. {--------}
  971. procedure TaaBreadthFirstIterator.Execute(aFromIndex : integer;
  972.                                           aExtraData : pointer);
  973. var
  974.   i          : integer;
  975.   NewNodeInx : integer;
  976.   Edge       : longint;
  977.   OurLevel   : integer;
  978.   OurIndex   : integer;
  979. begin
  980.   // perform preprocessing on the node
  981.   if Assigned(bfiPreProcess) then
  982.     bfiPreProcess(Self, aFromIndex, aExtraData);
  983.   // mark the node as preprocessed
  984.   with PitrCounter(bfiNodes[aFromIndex])^ do begin
  985.     cMarker := 1;
  986.   end;
  987.   // push the node onto the queue
  988.   bfiEnqueue(aFromIndex);
  989.   // whilst there are still items in the queue...
  990.   while not bfiQueueIsEmpty do begin
  991.     // pop the next item off the queue
  992.     OurIndex := bfiDequeue;
  993.     // perform postprocessing on the node
  994.     if Assigned(bfiPostProcess) then
  995.       bfiPostProcess(Self, OurIndex, aExtraData);
  996.     // mark the node as postprocessed
  997.     with PitrCounter(bfiNodes[OurIndex])^ do begin
  998.       cMarker := 2;
  999.       OurLevel := cLevel;
  1000.     end;
  1001.     // iterate through the edges from this node, push unvisited nodes
  1002.     // onto the queue
  1003.     i := 0;
  1004.     while bfiGraph.GetNodeEdge(OurIndex, i, Edge, NewNodeInx) do begin
  1005.       with PitrCounter(bfiNodes[NewNodeInx])^ do begin
  1006.         if (cMarker = 0) then begin
  1007.           // update process information
  1008.           cParent := OurIndex;
  1009.           cLevel := succ(OurLevel);
  1010.           // perform preprocessing on the node
  1011.           if Assigned(bfiPreProcess) then
  1012.             bfiPreProcess(Self, NewNodeInx, aExtraData);
  1013.           // mark the node as preprocessed
  1014.           cMarker := 1;
  1015.           // push the node onto the queue
  1016.           bfiEnqueue(NewNodeInx);
  1017.         end;
  1018.       end;
  1019.       inc(i);
  1020.     end;
  1021.   end;
  1022. end;
  1023. {--------}
  1024. procedure TaaBreadthFirstIterator.ExecuteAll(aExtraData : pointer);
  1025. var
  1026.   i : integer;
  1027. begin
  1028.   for i := 0 to pred(bfiGraph.NodeCount) do begin
  1029.     if (PitrCounter(bfiNodes[i])^.cMarker = 0) then
  1030.       Execute(i, aExtraData);
  1031.   end;
  1032. end;
  1033. {--------}
  1034. procedure TaaBreadthFirstIterator.Reset;
  1035. var
  1036.   i : integer;
  1037. begin
  1038.   for i := 0 to pred(bfiNodes.Count) do begin
  1039.     with PitrCounter(bfiNodes[i])^ do begin
  1040.       cIndex := i;
  1041.       cMarker := 0;
  1042.       cParent := -1;
  1043.       cLevel  := 0;
  1044.     end;
  1045.   end;
  1046. end;
  1047. {--------}
  1048. function TaaBreadthFirstIterator.ShortestPath(aFromIndex : integer;
  1049.                                               aToIndex   : integer;
  1050.                                               aExtraData : pointer) : boolean;
  1051. var
  1052.   SavedPreProc  : TaaProcessNode;
  1053.   SavedPostProc : TaaProcessNode;
  1054. begin
  1055.   // we don't want any interruptions
  1056.   SavedPreProc  := OnPreProcess;
  1057.   SavedPostProc := OnPostProcess;
  1058.   OnPreProcess := nil;
  1059.   OnPostProcess := nil;
  1060.   try
  1061.     // first execute the breadth first traversal: this sets up our
  1062.     // internal data structure
  1063.     Reset;
  1064.     Execute(aFromIndex, nil);
  1065.     // now traverse from the ToIndex node back to the FromIndex node
  1066.     // pushing visited nodes on the stack: we'll then unwind the stack
  1067.     // to print the shortest path
  1068.     Result := bfiShortPathPrim(aFromIndex, aToIndex, aExtraData);
  1069.   finally
  1070.     OnPreProcess := SavedPreProc;
  1071.     OnPostProcess := SavedPostProc;
  1072.   end;
  1073. end;
  1074. {====================================================================}
  1075.  
  1076.  
  1077. {===TaaPriorityFirstIterator=========================================}
  1078. constructor TaaPriorityFirstIterator.Create(aGraph : TaaGraph);
  1079. var
  1080.   i : integer;
  1081. begin
  1082.   inherited Create;
  1083.   if (aGraph = nil) then
  1084.     raise Exception.Create('TaaPriorityFirstIterator.Create: graph object is nil');
  1085.   pfiGraph := aGraph;
  1086.   pfiNodes := TList.Create;
  1087.   pfiNodes.Count := aGraph.NodeCount;
  1088.   for i := 0 to pred(pfiNodes.Count) do
  1089.     pfiNodes[i] := AllocMem(sizeof(TitrCounter));
  1090.   Reset;
  1091.   pfiQueue := TaaPriorityQueueEx.Create(ComparePriority);
  1092. end;
  1093. {--------}
  1094. destructor TaaPriorityFirstIterator.Destroy;
  1095. var
  1096.   i : integer;
  1097. begin
  1098.   for i := 0 to pred(pfiNodes.Count) do
  1099.     pfiDestroyCounter(i);
  1100.   pfiNodes.Free;
  1101.   pfiQueue.Free;
  1102.   inherited Destroy;
  1103. end;
  1104. {--------}
  1105. procedure TaaPriorityFirstIterator.pfiDestroyCounter(aIndex : integer);
  1106. var
  1107.   Counter : PitrCounter;
  1108. begin
  1109.   Counter := pfiNodes[aIndex];
  1110.   if (Counter <> nil) then
  1111.     Dispose(Counter);
  1112. end;
  1113. {--------}
  1114. function TaaPriorityFirstIterator.pfiTracePathPrim(aFromIndex : integer;
  1115.                                                    aToIndex   : integer;
  1116.                                                    aExtraData : pointer) : boolean;
  1117. var
  1118.   Parent : integer;
  1119. begin
  1120.   if (aFromIndex = aToIndex) then begin
  1121.     {we reached the source node, so print it & return success}
  1122.     if Assigned(pfiPrintNode) then
  1123.       pfiPrintNode(Self, aToIndex, aExtraData);
  1124.     Result := true;
  1125.   end
  1126.   else begin
  1127.     Parent := PitrCounter(pfiNodes[aToIndex])^.cParent;
  1128.     if (Parent = -1) then begin
  1129.       {we've hit a dead end-there is no path back to the source node}
  1130.       Result := false;
  1131.     end
  1132.     else begin
  1133.       {recurse to the parent, if successful print this node}
  1134.       if pfiTracePathPrim(aFromIndex, Parent, aExtraData) then begin
  1135.         if Assigned(pfiPrintNode) then
  1136.           pfiPrintNode(Self, aToIndex, aExtraData);
  1137.         Result := true;
  1138.       end
  1139.       else
  1140.         Result := false;
  1141.     end;
  1142.   end;
  1143. end;
  1144. {--------}
  1145. procedure TaaPriorityFirstIterator.Execute(aEvalPriority : TaaEvalPriority;
  1146.                                            aFromIndex : integer;
  1147.                                            aExtraData : pointer);
  1148. var
  1149.   i          : integer;
  1150.   NewNodeInx : integer;
  1151.   Edge       : longint;
  1152.   OurLevel   : integer;
  1153.   OurIndex   : integer;
  1154.   NewPriority: longint;
  1155. begin
  1156.   // perform preprocessing on the node
  1157.   if Assigned(pfiPreProcess) then
  1158.     pfiPreProcess(Self, aFromIndex, aExtraData);
  1159.   // mark the node as preprocessed
  1160.   with PitrCounter(pfiNodes[aFromIndex])^ do begin
  1161.     cMarker := 1;
  1162.     cPriority := 0;
  1163.     // push the node onto the queue
  1164.     cHandle := pfiQueue.Add(pfiNodes[aFromIndex]);
  1165.   end;
  1166.   // whilst there are still items in the queue...
  1167.   while (pfiQueue.Count <> 0) do begin
  1168.     // pop the next item off the queue
  1169.     OurIndex := PitrCounter(pfiQueue.Remove)^.cIndex;
  1170.     // perform postprocessing on the node
  1171.     if Assigned(pfiPostProcess) then
  1172.       pfiPostProcess(Self, OurIndex, aExtraData);
  1173.     // mark the node as postprocessed
  1174.     with PitrCounter(pfiNodes[OurIndex])^ do begin
  1175.       cMarker := 2;
  1176.       OurLevel := cLevel;
  1177.     end;
  1178.     // iterate through the edges from this node, push unvisited nodes
  1179.     // onto the queue
  1180.     i := 0;
  1181.     while pfiGraph.GetNodeEdge(OurIndex, i, Edge, NewNodeInx) do begin
  1182.       with PitrCounter(pfiNodes[NewNodeInx])^ do begin
  1183.         if (cMarker = 0) then begin {totally unvisited before}
  1184.           // update process information
  1185.           cParent := OurIndex;
  1186.           cLevel := succ(OurLevel);
  1187.           // perform preprocessing on the node
  1188.           if Assigned(pfiPreProcess) then
  1189.             pfiPreProcess(Self, NewNodeInx, aExtraData);
  1190.           // mark the node as preprocessed
  1191.           cMarker := 1;
  1192.           // calculate the priority
  1193.           cPriority := aEvalPriority(Self, OurIndex, Edge, NewNodeInx);
  1194.           // push the node onto the queue
  1195.           cHandle := pfiQueue.Add(pfiNodes[NewNodeInx]);
  1196.         end
  1197.         else if (cMarker = 1) then begin {already preprocessed}
  1198.           // calculate the new priority
  1199.           NewPriority := aEvalPriority(Self, OurIndex, Edge, NewNodeInx);
  1200.           // if it is less than the current one, update the node and
  1201.           // reheapify the queue
  1202.           if (NewPriority < cPriority) then begin
  1203.             cParent := OurIndex;
  1204.             cLevel := succ(OurLevel);
  1205.             cPriority := NewPriority;
  1206.             pfiQueue.Replace(cHandle, pfiNodes[NewNodeInx]);
  1207.           end;
  1208.         end;
  1209.       end;
  1210.       inc(i);
  1211.     end;
  1212.   end;
  1213. end;
  1214. {--------}
  1215. procedure TaaPriorityFirstIterator.ExecuteAll(aEvalPriority : TaaEvalPriority;
  1216.                                               aExtraData : pointer);
  1217. var
  1218.   i : integer;
  1219. begin
  1220.   for i := 0 to pred(pfiGraph.NodeCount) do begin
  1221.     if (PitrCounter(pfiNodes[i])^.cMarker = 0) then
  1222.       Execute(aEvalPriority, i, aExtraData);
  1223.   end;
  1224. end;
  1225. {--------}
  1226. function TaaPriorityFirstIterator.GetPriority(aNodeIndex : integer) : longint;
  1227. begin
  1228.   Result := PitrCounter(pfiNodes[aNodeIndex])^.cPriority;
  1229. end;
  1230. {--------}
  1231. procedure TaaPriorityFirstIterator.Reset;
  1232. var
  1233.   i : integer;
  1234. begin
  1235.   for i := 0 to pred(pfiNodes.Count) do begin
  1236.     with PitrCounter(pfiNodes[i])^ do begin
  1237.       cIndex := i;
  1238.       cMarker := 0;
  1239.       cParent := -1;
  1240.       cLevel  := 0;
  1241.       cPriority := InfinitePriority;
  1242.       cHandle := nil;
  1243.     end;
  1244.   end;
  1245. end;
  1246. {--------}
  1247. function TaaPriorityFirstIterator.TracePath(aFromIndex : integer;
  1248.                                             aToIndex   : integer;
  1249.                                             aExtraData : pointer) : boolean;
  1250. var
  1251.   SavedPreProc  : TaaProcessNode;
  1252.   SavedPostProc : TaaProcessNode;
  1253. begin
  1254.   // we don't want any interruptions
  1255.   SavedPreProc  := OnPreProcess;
  1256.   SavedPostProc := OnPostProcess;
  1257.   OnPreProcess := nil;
  1258.   OnPostProcess := nil;
  1259.   try
  1260.     // traverse from the ToIndex node back to the FromIndex node
  1261.     // pushing visited nodes on the stack: we'll then unwind the stack
  1262.     // to print the shortest path
  1263.     Result := pfiTracePathPrim(aFromIndex, aToIndex, aExtraData);
  1264.   finally
  1265.     OnPreProcess := SavedPreProc;
  1266.     OnPostProcess := SavedPostProc;
  1267.   end;
  1268. end;
  1269. {====================================================================}
  1270.  
  1271.  
  1272. {===Interfaced routines==============================================}
  1273. function EvalDijkstrasPriority(aSender    : TObject;
  1274.                                aFromIndex : integer;
  1275.                                aEdgeCost  : longint;
  1276.                                aToIndex   : integer) : longint;
  1277. begin
  1278.   with (aSender as TaaPriorityFirstIterator) do
  1279.     Result := GetPriority(aFromIndex) + aEdgeCost;
  1280. end;
  1281. {--------}
  1282. function EvalPrimsPriority(aSender    : TObject;
  1283.                            aFromIndex : integer;
  1284.                            aEdgeCost  : longint;
  1285.                            aToIndex   : integer) : longint;
  1286. begin
  1287.   Result := aEdgeCost;
  1288. end;
  1289. {--------}
  1290. procedure MinSpanningTree(aGraph       : TaaGraph;
  1291.                           aProcessNode : TaaProcessNode;
  1292.                           aExtraData   : pointer);
  1293. var
  1294.   Iter : TaaPriorityFirstIterator;
  1295. begin
  1296.   Iter := TaaPriorityFirstIterator.Create(aGraph);
  1297.   Iter.OnPostProcess := aProcessNode;
  1298.   try
  1299.     Iter.Execute(EvalPrimsPriority, 0, aExtraData);
  1300.   finally
  1301.     Iter.Free;
  1302.   end;
  1303. end;
  1304. {--------}
  1305. procedure SmallestCostPath(aGraph       : TaaGraph;
  1306.                            aFromIndex   : integer;
  1307.                            aToIndex     : integer;
  1308.                            aProcessNode : TaaProcessNode;
  1309.                            aExtraData   : pointer);
  1310. var
  1311.   Iter : TaaPriorityFirstIterator;
  1312. begin
  1313.   Iter := TaaPriorityFirstIterator.Create(aGraph);
  1314.   Iter.OnPrintNode := aProcessNode;
  1315.   try
  1316.     Iter.Execute(EvalDijkstrasPriority, aFromIndex, nil);
  1317.     Iter.TracePath(aFromIndex, aToIndex, aExtraData);
  1318.   finally
  1319.     Iter.Free;
  1320.   end;
  1321. end;
  1322.  
  1323. {====================================================================}
  1324.  
  1325. end.
  1326.